Forecasting: Principles and Practices, 3rd ed. - Chapter 5 Exercises

Author

R. J. Serrano

Chapter 5 Exercises

Exercise 5.11.1

Produce forecast for various time series:

Set training data from 1970 Q1 to 2002 Q4

bricks_train <- aus_production %>% 
     filter_index("1970 Q1" ~ "2004 Q4") %>% 
     select(Bricks)

bricks_train %>% 
     autoplot() + 
     geom_smooth(method = 'loess', se = FALSE) + 
     labs(title = "Australian Clay Brick Production", 
          y = "Units (million)")

Fit the models (Naive, Seasonal Naive, Drift)

bricks_fit <- bricks_train %>%
     model(
          `Naïve` = NAIVE(Bricks),
          `Seasonal naïve` = SNAIVE(Bricks), 
          Drift = RW(Bricks ~ drift())
     )

# Generate forecasts for 10 quarters
bricks_fc <- bricks_fit %>% 
     forecast(h = 10)

bricks_fc %>% 
     knitr::kable()
.model Quarter Bricks .mean
Naïve 2005 Q1 N(397, 1960) 397.0000
Naïve 2005 Q2 N(397, 3920) 397.0000
Naïve 2005 Q3 N(397, 5880) 397.0000
Naïve 2005 Q4 N(397, 7840) 397.0000
Naïve 2006 Q1 N(397, 9801) 397.0000
Naïve 2006 Q2 N(397, 11761) 397.0000
Naïve 2006 Q3 N(397, 13721) 397.0000
Naïve 2006 Q4 N(397, 15681) 397.0000
Naïve 2007 Q1 N(397, 17641) 397.0000
Naïve 2007 Q2 N(397, 19601) 397.0000
Seasonal naïve 2005 Q1 N(409, 3026) 409.0000
Seasonal naïve 2005 Q2 N(423, 3026) 423.0000
Seasonal naïve 2005 Q3 N(428, 3026) 428.0000
Seasonal naïve 2005 Q4 N(397, 3026) 397.0000
Seasonal naïve 2006 Q1 N(409, 6053) 409.0000
Seasonal naïve 2006 Q2 N(423, 6053) 423.0000
Seasonal naïve 2006 Q3 N(428, 6053) 428.0000
Seasonal naïve 2006 Q4 N(397, 6053) 397.0000
Seasonal naïve 2007 Q1 N(409, 9079) 409.0000
Seasonal naïve 2007 Q2 N(423, 9079) 423.0000
Drift 2005 Q1 N(397, 1974) 397.0791
Drift 2005 Q2 N(397, 3977) 397.1583
Drift 2005 Q3 N(397, 6008) 397.2374
Drift 2005 Q4 N(397, 8068) 397.3165
Drift 2006 Q1 N(397, 10156) 397.3957
Drift 2006 Q2 N(397, 12272) 397.4748
Drift 2006 Q3 N(398, 14417) 397.5540
Drift 2006 Q4 N(398, 16590) 397.6331
Drift 2007 Q1 N(398, 18791) 397.7122
Drift 2007 Q2 N(398, 21021) 397.7914

Plot time series with forecasts

bricks_fc %>% 
     autoplot(bricks_train, level = NULL) +
     autolayer(
          filter_index(aus_production, "2005 Q1" ~ "2007 Q2"),
          colour = "black"
     ) +
     labs(
          y = "Megalitres",
          title = "Forecasts for quarterly beer production"
     ) +
     guides(colour = guide_legend(title = "Forecast"))

Using timetk and modeltime packages

suppressPackageStartupMessages({
     library(timetk)
     library(lubridate)
     library(rsample)
     library(modeltime)
     library(parsnip)
})

Create data_tk as tibble

data_tk <- aus_production %>% 
     mutate(date = as.Date(Quarter)) %>% 
     filter(date >= '1970-01-01' & date <= '2005-04-01') %>% 
     as_tibble() %>% 
     select(date, Bricks, -Quarter)

Split data_tk into train/test

split_tk <- time_series_split(
     data = data_tk, 
     initial = 132, # end date == '2002-10-01' (2002 Q4)
     assess = 10 # remainder use as testing
)

# plot train and test time series
split_tk %>% 
     tk_time_series_cv_plan() %>% 
     plot_time_series_cv_plan(date, Bricks)
train_tk <- training(split_tk)
test_tk <- testing(split_tk)

Fit models (naive, snaive)

naive_mod <- naive_reg() %>% 
     set_engine('naive') %>% 
     fit(Bricks ~ date, data = train_tk)

snaive_mod <- naive_reg() %>% 
     set_engine('snaive') %>% 
     fit(Bricks ~ date, data = train_tk)

models_tbl <- modeltime_table(
     naive_mod, 
     snaive_mod
)

Generate forecast

calibration_tbl <- models_tbl %>% 
     modeltime_calibrate(new_data = test_tk)

calibration_tbl %>% 
     modeltime_forecast(
          new_data = test_tk, 
          actual_data = data_tk
     ) %>% 
     plot_modeltime_forecast(
          .legend_max_width = 25,  # for mobile screens
          .interactive = TRUE
     )

Set training data from 1995 Q1 to 2012

hh_wealth <- hh_budget %>% 
     select(Country, Year, Wealth) %>% 
     filter(Country == 'Australia') %>% 
     select(-Country) %>% 
     as_tsibble(index = Year)
     

household_wealth_Australia_train <- hh_wealth %>% 
     filter(Year <= 2012)

household_wealth_Australia_train %>% 
     autoplot() + 
     geom_smooth(method = 'loess', se = FALSE) + 
     ylab("Percentage of net disposable income") + 
     ggtitle("Australia Household Wealth (1995 - 2012)")

Fit models (Naive, Drift)

Seasonal naive is not appropriate, since the model does not exhibit a seasonal pattern.

household_fit <- household_wealth_Australia_train %>%
     model(
          `Naïve` = NAIVE(Wealth),
          Drift = RW(Wealth ~ drift())
     )

# Generate forecasts for 4 years
household_fc <- household_fit %>% 
     forecast(h = 4)

household_fc %>% 
     knitr::kable()
.model Year Wealth .mean
Naïve 2013 N(353, 578) 353.0001
Naïve 2014 N(353, 1156) 353.0001
Naïve 2015 N(353, 1733) 353.0001
Naïve 2016 N(353, 2311) 353.0001
Drift 2013 N(355, 609) 355.2393
Drift 2014 N(357, 1289) 357.4784
Drift 2015 N(360, 2041) 359.7176
Drift 2016 N(362, 2864) 361.9567

Plot time series with forecast

household_fc %>% 
     autoplot(household_wealth_Australia_train, level = NULL) + 
     autolayer(
          filter_index(hh_wealth, "2013" ~ "2016"),
          colour = "black"
     ) + 
     labs(
          y = "Percentage of net disposable income",
          title = "Forecasts for Australia Household Wealth"
     ) + 
     guides(colour = guide_legend(title = "Forecast"))

Using timetk and modeltime packages

Create wealth_tk as tibble

wealth_tk <- hh_wealth %>% 
     mutate(date = as.Date(paste(Year, 1, 1, sep = "-"))) %>% 
     as_tibble() %>% 
     select(date, Wealth)

Split wealth_tk into train/test

split_tk <- time_series_split(
     data = wealth_tk, 
     initial = 18, # end date == 2012
     assess = 4 # remainder use as testing
)

# plot train and test time series
split_tk %>% 
     tk_time_series_cv_plan() %>% 
     plot_time_series_cv_plan(date, Wealth)
train_tk <- training(split_tk)
test_tk <- testing(split_tk)

Fit models (naive, snaive)

naive_mod <- naive_reg() %>% 
     set_engine('naive') %>% 
     fit(Wealth ~ date, data = train_tk)

# using linear regression model (replacing snaive)
linear_mod <- linear_reg() %>% 
     set_engine('lm') %>% 
     fit(Wealth ~ as.numeric(date), data = train_tk)

models_tbl <- modeltime_table(
     naive_mod, 
     linear_mod
)

Generate forecast

calibration_tbl <- models_tbl %>% 
     modeltime_calibrate(new_data = test_tk)

calibration_tbl %>% 
     modeltime_forecast(
          new_data = test_tk, 
          actual_data = wealth_tk
     ) %>% 
     plot_modeltime_forecast(
          .legend_max_width = 25,  # for mobile screens
          .interactive = TRUE
     )

Exercise 5.11.3

Residual diagnostics

Create recent_production tsibble

recent_production <- aus_production %>%
     filter(year(Quarter) >= 1992)

# plot time series
recent_production %>% 
     autoplot(Beer) + 
     geom_smooth(method = 'loess', se = FALSE) + 
     labs(title = "Australian Beer Production", 
          y = "Megaliters")

STL decomposition method

dcmp <- recent_production %>%
     model(stl = STL(Beer))

components(dcmp) %>% 
     knitr::kable()
.model Quarter Beer trend season_year remainder season_adjust
stl 1992 Q1 443 452.2199 -10.3300715 1.1101679 453.3301
stl 1992 Q2 410 451.2616 -40.4020627 -0.8595182 450.4021
stl 1992 Q3 420 450.4126 -28.9337159 -1.4789150 448.9337
stl 1992 Q4 532 449.8671 79.6832660 2.4496271 452.3167
stl 1993 Q1 433 450.3962 -10.3195634 -7.0766323 443.3196
stl 1993 Q2 421 447.1911 -40.4722434 14.2811796 461.4722
stl 1993 Q3 410 445.4794 -28.8628094 -6.6165903 438.8628
stl 1993 Q4 512 442.7604 79.6552017 -10.4155592 432.3448
stl 1994 Q1 449 439.9110 -10.3024351 19.3913971 459.3024
stl 1994 Q2 381 443.0404 -40.5363266 -21.5041046 421.5363
stl 1994 Q3 423 443.1152 -28.7855220 8.6703626 451.7855
stl 1994 Q4 531 444.3530 79.6344568 7.0125553 451.3655
stl 1995 Q1 426 445.7260 -10.2006739 -9.5252793 436.2007
stl 1995 Q2 408 443.8992 -40.8904139 4.9912564 448.8904
stl 1995 Q3 416 441.1998 -28.4405608 3.2407864 444.4406
stl 1995 Q4 520 436.7300 79.5506162 3.7194233 440.4494
stl 1996 Q1 409 432.9912 -10.1147207 -13.8764718 419.1147
stl 1996 Q2 398 429.6884 -41.2763929 9.5879968 439.2764
stl 1996 Q3 398 430.7313 -28.1455196 -4.5857531 426.1455
stl 1996 Q4 507 433.2031 79.4136073 -5.6167049 427.5864
stl 1997 Q1 432 435.1494 -9.6694102 6.5199866 441.6694
stl 1997 Q2 398 438.1685 -41.6379932 1.4695295 439.6380
stl 1997 Q3 406 439.9116 -27.3214040 -6.5901551 433.3214
stl 1997 Q4 526 439.6944 78.0171377 8.2884955 447.9829
stl 1998 Q1 428 439.2462 -9.0837258 -2.1624456 437.0837
stl 1998 Q2 397 437.1754 -41.9858133 1.8104477 438.9858
stl 1998 Q3 403 436.8272 -26.6560516 -7.1711538 429.6561
stl 1998 Q4 517 436.4866 76.3246404 4.1888066 440.6754
stl 1999 Q1 435 436.9572 -6.7572967 4.8000870 441.7573
stl 1999 Q2 383 439.6280 -42.9636767 -13.6643379 425.9637
stl 1999 Q3 424 439.7728 -25.1267185 9.3539660 449.1267
stl 1999 Q4 521 440.0297 73.0037183 7.9665988 447.9963
stl 2000 Q1 421 439.9613 -4.2583140 -14.7029891 425.2583
stl 2000 Q2 402 437.0689 -43.7745809 8.7056669 445.7746
stl 2000 Q3 414 438.1913 -23.5026932 -0.6885790 437.5027
stl 2000 Q4 500 438.9829 69.6879685 -8.6708798 430.3120
stl 2001 Q1 451 436.5526 -2.8585356 17.3059337 453.8585
stl 2001 Q2 380 435.6819 -42.7483584 -12.9335246 422.7484
stl 2001 Q3 416 431.8952 -21.3046471 5.4094200 437.3046
stl 2001 Q4 492 432.1829 64.5689072 -4.7518108 427.4311
stl 2002 Q1 428 434.3772 -1.2865439 -5.0906078 429.2865
stl 2002 Q2 408 435.5331 -41.5510459 14.0179630 449.5510
stl 2002 Q3 406 438.2112 -18.9743680 -13.2368176 424.9744
stl 2002 Q4 506 435.6392 59.5287152 10.8320667 446.4713
stl 2003 Q1 435 433.5345 0.1033629 1.3620982 434.8966
stl 2003 Q2 380 432.8350 -39.8742693 -12.9606856 419.8743
stl 2003 Q3 421 431.8303 -19.0399605 8.2097065 440.0400
stl 2003 Q4 490 433.1108 57.3542448 -0.4650531 432.6458
stl 2004 Q1 435 432.4160 1.2480129 1.3359386 433.7520
stl 2004 Q2 390 427.8281 -38.2831254 0.4549952 428.2831
stl 2004 Q3 412 420.6817 -18.9603320 10.2786706 430.9603
stl 2004 Q4 454 418.3394 55.5010795 -19.8405091 398.4989
stl 2005 Q1 416 420.1571 0.5208343 -4.6779185 415.4792
stl 2005 Q2 403 424.8329 -37.3198862 15.4870257 440.3199
stl 2005 Q3 408 430.0892 -18.6096968 -3.4795138 426.6097
stl 2005 Q4 482 430.5233 55.8602103 -4.3834907 426.1398
stl 2006 Q1 438 428.5988 -0.5887347 9.9899046 438.5887
stl 2006 Q2 386 428.5035 -36.6667487 -5.8368003 422.6667
stl 2006 Q3 405 428.1448 -18.4223506 -4.7224881 423.4224
stl 2006 Q4 491 427.4640 56.2056380 7.3304057 434.7944
stl 2007 Q1 427 425.6241 -1.2511133 2.6270026 428.2511
stl 2007 Q2 383 421.1599 -36.5648259 -1.5951184 419.5648
stl 2007 Q3 394 417.8141 -18.3154992 -5.4985940 412.3155
stl 2007 Q4 473 418.1095 56.4043041 -1.5138216 416.5957
stl 2008 Q1 420 421.3377 -1.7920752 0.4543681 421.7921
stl 2008 Q2 390 425.2086 -36.4089235 1.2003582 426.4089
stl 2008 Q3 410 426.8129 -18.2124527 1.3995597 428.2125
stl 2008 Q4 488 426.7012 56.5659031 4.7329348 431.4341
stl 2009 Q1 415 428.3007 -2.0109027 -11.2898096 417.0109
stl 2009 Q2 398 430.0439 -36.3698691 4.3259951 434.3699
stl 2009 Q3 419 430.8406 -18.2056294 6.3650776 437.2056
stl 2009 Q4 488 425.3169 56.7156548 5.9674082 431.2843
stl 2010 Q1 414 419.1856 -2.2236031 -2.9620202 416.2236
stl 2010 Q2 374 412.2138 -36.3272758 -1.8864764 410.3273 
# plot STL decomposition
components(dcmp) %>% 
     autoplot()

Fit a model (snaive)

fit <- recent_production %>% 
     model(SNAIVE(Beer))

Plot residual diagnostics

fit %>% 
     gg_tsresiduals()

There is a strong autocorrelation in lag 4 as shown in the ACF plot.

Plot forecast

fit %>% 
     forecast() %>% 
     autoplot(recent_production)

Exercise 5.11.4

Repeat exercise 5.11.3 with Australian exports series from ‘global_economy’ and the Bricks series from ‘aus_production’

aus_exports <- global_economy %>% 
     select(Country, Year, Exports) %>% 
     filter(Country == 'Australia')

Plot time series

aus_exports %>% 
     autoplot() + 
     geom_smooth(method = 'loess', se = FALSE) + 
     labs(title = "Australian Exports", 
          y = "% GDP")

STL decomposition method

dcmp <- aus_exports %>%
     model(stl = STL(Exports))

components(dcmp) %>% 
     knitr::kable()
Country .model Year Exports trend remainder season_adjust
Australia stl 1960 12.99445 12.62096 0.3734902 12.99445
Australia stl 1961 12.40310 12.73964 -0.3365387 12.40310
Australia stl 1962 13.94301 12.85832 1.0846949 13.94301
Australia stl 1963 13.00589 12.95167 0.0542166 13.00589
Australia stl 1964 14.93825 13.00516 1.9330852 14.93825
Australia stl 1965 13.22018 13.03728 0.1828998 13.22018
Australia stl 1966 12.93238 13.03350 -0.1011187 12.93238
Australia stl 1967 12.88373 13.00019 -0.1164555 12.88373
Australia stl 1968 12.29767 12.94883 -0.6511632 12.29767
Australia stl 1969 11.95486 12.94025 -0.9853930 11.95486
Australia stl 1970 12.97704 12.96038 0.0166591 12.97704
Australia stl 1971 12.66127 13.03857 -0.3772925 12.66127
Australia stl 1972 12.82576 13.17581 -0.3500498 12.82576
Australia stl 1973 14.15502 13.37546 0.7795611 14.15502
Australia stl 1974 13.15200 13.54074 -0.3887435 13.15200
Australia stl 1975 14.28150 13.69670 0.5847969 14.28150
Australia stl 1976 13.52313 13.85711 -0.3339850 13.52313
Australia stl 1977 14.02290 14.02311 -0.0002092 14.02290
Australia stl 1978 13.62817 14.14240 -0.5142217 13.62817
Australia stl 1979 14.31198 14.28162 0.0303642 14.31198
Australia stl 1980 16.43947 14.39019 2.0492750 16.43947
Australia stl 1981 14.91207 14.42960 0.4824687 14.91207
Australia stl 1982 13.54104 14.42348 -0.8824465 13.54104
Australia stl 1983 13.59473 14.48475 -0.8900169 13.59473
Australia stl 1984 13.58022 14.60348 -1.0232655 13.58022
Australia stl 1985 15.25999 14.77840 0.4815839 15.25999
Australia stl 1986 15.01374 14.98014 0.0335975 15.01374
Australia stl 1987 15.49431 15.22561 0.2687010 15.49431
Australia stl 1988 15.98415 15.45232 0.5318220 15.98415
Australia stl 1989 15.14587 15.66809 -0.5222229 15.14587
Australia stl 1990 15.14356 15.94009 -0.7965297 15.14356
Australia stl 1991 16.05904 16.31334 -0.2542985 16.05904
Australia stl 1992 16.69140 16.75360 -0.0621915 16.69140
Australia stl 1993 17.57366 17.24610 0.3275627 17.57366
Australia stl 1994 18.00589 17.75045 0.2554454 18.00589
Australia stl 1995 17.91688 18.16521 -0.2483273 17.91688
Australia stl 1996 18.93919 18.51639 0.4228052 18.93919
Australia stl 1997 19.17481 18.81069 0.3641180 19.17481
Australia stl 1998 19.59558 19.00977 0.5858046 19.59558
Australia stl 1999 18.35396 19.13727 -0.7833195 18.35396
Australia stl 2000 19.44348 19.26707 0.1764126 19.44348
Australia stl 2001 22.23518 19.39948 2.8356975 22.23518
Australia stl 2002 20.78314 19.49404 1.2891008 20.78314
Australia stl 2003 19.10300 19.61174 -0.5087317 19.10300
Australia stl 2004 17.21976 19.76517 -2.5454015 17.21976
Australia stl 2005 18.28530 19.90914 -1.6238396 18.28530
Australia stl 2006 19.90813 20.00774 -0.0996156 19.90813
Australia stl 2007 20.23057 20.09674 0.1338331 20.23057
Australia stl 2008 20.18870 20.17636 0.0123398 20.18870
Australia stl 2009 23.03851 20.26347 2.7750410 23.03851
Australia stl 2010 19.84252 20.35178 -0.5092625 19.84252
Australia stl 2011 21.47284 20.45033 1.0225111 21.47284
Australia stl 2012 21.51897 20.54749 0.9714815 21.51897
Australia stl 2013 19.98772 20.62409 -0.6363709 19.98772
Australia stl 2014 21.07577 20.64806 0.4277034 21.07577
Australia stl 2015 20.01296 20.65372 -0.6407528 20.01296
Australia stl 2016 19.25303 20.64575 -1.3927275 19.25303
Australia stl 2017 21.27035 20.63779 0.6325623 21.27035 
# plot STL decomposition
components(dcmp) %>% 
     autoplot()

Fit a model (naive)

fit <- aus_exports %>% 
     model(NAIVE(Exports))

Plot residual diagnostics

fit %>% 
     gg_tsresiduals()

Plot forecast

fit %>% 
     forecast() %>% 
     autoplot(aus_exports)

bricks <- aus_production %>% 
     select(Quarter, Bricks) %>% 
     na.omit()

bricks %>% 
     autoplot() + 
     geom_smooth(method = 'loess', se = FALSE) + 
     labs(title = "Australian Clay Brick Production", 
          y = "Units (million)")

STL decomposition method

dcmp <- bricks %>%
     model(stl = STL(Bricks))

components(dcmp) %>% 
     knitr::kable()
.model Quarter Bricks trend season_year remainder season_adjust
stl 1956 Q1 189 204.3283 -21.3123536 5.9840484 210.3124
stl 1956 Q2 204 202.0349 3.3507110 -1.3856307 200.6493
stl 1956 Q3 208 200.5663 16.6075861 -9.1738871 191.3924
stl 1956 Q4 197 199.8229 1.4352761 -4.2581797 195.5647
stl 1957 Q1 187 204.1946 -21.4514499 4.2568576 208.4514
stl 1957 Q2 214 209.4690 3.2914669 1.2395689 210.7085
stl 1957 Q3 227 213.8472 16.7969574 -3.6441706 210.2030
stl 1957 Q4 222 217.4404 1.4576411 3.1019935 220.5424
stl 1958 Q1 199 222.0018 -21.5871625 -1.4146221 220.5872
stl 1958 Q2 229 226.1809 3.2476102 -0.4284878 225.7524
stl 1958 Q3 249 229.1857 17.0110734 2.8031846 231.9889
stl 1958 Q4 234 232.5986 1.5002143 -0.0988037 232.4998
stl 1959 Q1 208 237.3662 -22.0458585 -7.3203196 230.0459
stl 1959 Q2 251 242.6973 3.1681308 5.1345960 247.8319
stl 1959 Q3 267 249.6047 17.5977894 -0.2025081 249.4022
stl 1959 Q4 255 255.8346 1.6020999 -2.4366840 253.3979
stl 1960 Q1 242 261.0039 -22.5676629 3.5638019 264.5677
stl 1960 Q2 268 266.4780 3.0657398 -1.5437780 264.9343
stl 1960 Q3 290 269.4592 18.2028627 2.3379190 271.7971
stl 1960 Q4 277 268.0319 1.7464668 7.2216727 275.2535
stl 1961 Q1 241 262.4041 -23.3890483 1.9849366 264.3890
stl 1961 Q2 253 253.6057 2.9080988 -3.5138423 250.0919
stl 1961 Q3 265 246.5325 19.0615959 -0.5941086 245.9384
stl 1961 Q4 236 246.4435 1.9430885 -12.3866315 234.0569
stl 1962 Q1 229 250.0799 -24.2284183 3.1484684 253.2284
stl 1962 Q2 265 254.6315 2.7510430 7.6174724 262.2490
stl 1962 Q3 275 257.1019 19.9376896 -2.0396377 255.0623
stl 1962 Q4 258 256.8643 2.1621605 -1.0264326 255.8378
stl 1963 Q1 231 260.0743 -25.8787198 -3.1955428 256.8787
stl 1963 Q2 263 270.7177 3.9944442 -11.7121121 259.0056
stl 1963 Q3 308 286.4979 20.1494126 1.3527116 287.8506
stl 1963 Q4 313 303.4060 2.2334322 7.3605357 310.7666
stl 1964 Q1 293 316.1307 -27.4956683 4.3649701 320.4957
stl 1964 Q2 328 323.9892 5.2470521 -1.2362185 322.7529
stl 1964 Q3 349 329.5442 20.3390692 -0.8832980 328.6609
stl 1964 Q4 340 334.3877 2.2599830 3.3523628 337.7400
stl 1965 Q1 309 338.9239 -28.5285431 -1.3953362 337.5285
stl 1965 Q2 349 341.1973 5.9716513 1.8310964 343.0283
stl 1965 Q3 366 340.6228 20.2930066 5.0842237 345.7070
stl 1965 Q4 340 339.1622 2.7552582 -1.9174909 337.2447
stl 1966 Q1 302 338.4988 -29.6188755 -6.8798802 331.6189
stl 1966 Q2 350 338.3772 6.6424595 4.9802977 343.3575
stl 1966 Q3 362 338.5954 20.2036901 3.2008777 341.7963
stl 1966 Q4 337 339.1993 3.2251535 -5.4244536 333.7748
stl 1967 Q1 306 340.2085 -30.5364047 -3.6721321 336.5364
stl 1967 Q2 358 342.6063 7.2237710 8.1699007 350.7762
stl 1967 Q3 359 348.8070 20.4347314 -10.2417239 338.5653
stl 1967 Q4 357 356.2142 3.0979109 -2.3121231 353.9021
stl 1968 Q1 341 365.2802 -31.3656881 7.0854529 372.3657
stl 1968 Q2 380 376.6115 7.8755767 -4.4870612 372.1244
stl 1968 Q3 404 388.2796 20.7194972 -4.9990957 383.2805
stl 1968 Q4 409 399.3998 3.0122189 6.5879380 405.9878
stl 1969 Q1 383 409.8860 -31.5596768 4.6736424 414.5597
stl 1969 Q2 417 417.9626 6.7711724 -7.7337432 410.2288
stl 1969 Q3 454 421.3623 21.8094304 10.8282510 432.1906
stl 1969 Q4 428 423.0962 3.6084590 1.2953544 424.3915
stl 1970 Q1 386 421.4424 -31.8585252 -3.5838716 417.8585
stl 1970 Q2 428 417.5515 5.6364251 4.8121124 422.3636
stl 1970 Q3 434 415.9018 22.9388772 -4.8407004 411.0611
stl 1970 Q4 417 416.3744 4.2532661 -3.6277125 412.7467
stl 1971 Q1 385 419.4954 -34.3630551 -0.1323529 419.3631
stl 1971 Q2 433 424.1612 6.2473618 2.5913984 426.7526
stl 1971 Q3 453 428.6302 25.9936598 -1.6238371 427.0063
stl 1971 Q4 436 433.6979 2.8559629 -0.5538810 433.1440
stl 1972 Q1 399 439.9978 -36.8016605 -4.1961495 435.8017
stl 1972 Q2 461 447.5154 7.0111490 6.4734043 453.9889
stl 1972 Q3 476 459.3846 29.2582512 -12.6428698 446.7417
stl 1972 Q4 477 467.8971 1.6907784 7.4121491 475.3092
stl 1973 Q1 452 474.1980 -40.2684653 18.0705137 492.2685
stl 1973 Q2 461 484.0287 8.7061448 -31.7348488 452.2939
stl 1973 Q3 534 493.6283 30.9210320 9.4506969 503.0790
stl 1973 Q4 516 507.1917 2.1135213 6.6947763 513.8865
stl 1974 Q1 478 512.7585 -43.8749944 9.1165134 521.8750
stl 1974 Q2 526 499.3004 10.2089483 16.4906228 515.7911
stl 1974 Q3 518 468.8185 32.3846451 16.7968892 485.6154
stl 1974 Q4 417 436.6760 2.3871858 -22.0631878 414.6128
stl 1975 Q1 340 417.4695 -46.0951036 -31.3743874 386.0951
stl 1975 Q2 437 416.6620 11.9187787 8.4191714 425.0812
stl 1975 Q3 459 431.8416 31.8272340 -4.6688057 427.1728
stl 1975 Q4 449 449.9139 3.0553349 -3.9692127 445.9447
stl 1976 Q1 424 468.5160 -48.1703486 3.6543181 472.1703
stl 1976 Q2 501 489.0586 13.6212939 -1.6798890 487.3787
stl 1976 Q3 540 504.5661 31.1239400 4.3099172 508.8761
stl 1976 Q4 533 510.6628 3.5128060 18.8243837 529.4872
stl 1977 Q1 457 508.9830 -47.7767634 -4.2062308 504.7768
stl 1977 Q2 513 499.4351 13.4113386 0.1535129 499.5887
stl 1977 Q3 522 488.0789 29.3083489 4.6127758 492.6917
stl 1977 Q4 478 479.5084 5.4651415 -6.9735590 472.5349
stl 1978 Q1 421 470.7512 -47.4814934 -2.2697402 468.4815
stl 1978 Q2 487 464.4508 13.0855652 9.4636711 473.9144
stl 1978 Q3 470 467.8086 27.3519074 -25.1605356 442.6481
stl 1978 Q4 482 478.0987 7.2507385 -3.3494552 474.7493
stl 1979 Q1 458 497.0574 -47.9068076 8.8493972 505.9068
stl 1979 Q2 526 519.8497 14.5214202 -8.3710863 511.4786
stl 1979 Q3 573 537.5319 26.7178662 8.7502603 546.2821
stl 1979 Q4 563 548.4829 6.0320379 8.4850983 556.9680
stl 1980 Q1 513 551.9105 -48.0030729 9.0926002 561.0031
stl 1980 Q2 551 553.2474 16.3055854 -18.5530081 534.6944
stl 1980 Q3 589 554.8679 26.3978617 7.7342827 562.6021
stl 1980 Q4 564 560.1719 5.0771307 -1.2489940 558.9229
stl 1981 Q1 519 562.5031 -48.8409034 5.3377689 567.8409
stl 1981 Q2 581 562.7330 17.6457186 0.6213118 563.3543
stl 1981 Q3 581 562.5663 26.9201616 -8.4864688 554.0798
stl 1981 Q4 578 558.5213 4.1554130 15.3232560 573.8446
stl 1982 Q1 501 547.8994 -49.7255480 2.8261569 550.7255
stl 1982 Q2 560 519.1185 18.9264747 21.9549989 541.0735
stl 1982 Q3 512 473.1416 27.3839279 11.4744275 484.6161
stl 1982 Q4 412 425.2369 3.1914555 -16.4283452 408.8085
stl 1983 Q1 303 393.5587 -50.4082553 -40.1504340 353.4083
stl 1983 Q2 409 384.7267 20.5545961 3.7187087 388.4454
stl 1983 Q3 420 398.2369 28.2552701 -6.4921792 391.7447
stl 1983 Q4 413 417.9690 0.7574601 -5.7264631 412.2425
stl 1984 Q1 400 434.2104 -50.8973295 16.6869694 450.8973
stl 1984 Q2 469 449.8675 22.2533480 -3.1208189 446.7467
stl 1984 Q3 482 463.9286 29.0419101 -10.9704687 452.9581
stl 1984 Q4 484 476.1126 -1.8894812 9.7768655 485.8895
stl 1985 Q1 447 487.1526 -49.1952082 9.0426153 496.1952
stl 1985 Q2 507 495.0509 21.7059582 -9.7568901 485.2940
stl 1985 Q3 533 497.8259 29.6029631 5.5711357 503.3970
stl 1985 Q4 505 497.2513 -2.8925001 10.6412311 507.8925
stl 1986 Q1 442 492.4233 -47.7864898 -2.6368528 489.7865
stl 1986 Q2 503 481.5453 20.9482915 0.5064438 482.0517
stl 1986 Q3 506 469.9500 30.0457446 6.0042659 475.9543
stl 1986 Q4 443 463.1580 -3.9536022 -16.2043792 446.9536
stl 1987 Q1 414 460.0995 -46.8005756 0.7010392 460.8006
stl 1987 Q2 485 461.7219 20.9839961 2.2940851 464.0160
stl 1987 Q3 495 464.6085 29.1166708 1.2748703 465.8833
stl 1987 Q4 458 469.7598 -3.6044069 -8.1554324 461.6044
stl 1988 Q1 428 481.4399 -45.9738484 -7.4660640 473.9738
stl 1988 Q2 519 499.8681 20.9578368 -1.8259762 498.0422
stl 1988 Q3 555 520.5565 28.2933094 6.1501767 526.7067
stl 1988 Q4 538 537.6448 -2.9521621 3.3073529 540.9522
stl 1989 Q1 510 545.0580 -44.9193787 9.8614141 554.9194
stl 1989 Q2 571 541.4584 19.4805063 10.0611214 551.5195
stl 1989 Q3 556 529.8748 26.9261552 -0.8009190 529.0738
stl 1989 Q4 509 515.2224 -1.3341345 -4.8882708 510.3341
stl 1990 Q1 458 500.8641 -43.7368140 0.8727620 501.7368
stl 1990 Q2 510 487.1111 17.9844822 4.9044667 492.0155
stl 1990 Q3 494 470.1987 25.4429718 -1.6416277 468.5570
stl 1990 Q4 460 449.5044 0.1201268 10.3754351 459.8799
stl 1991 Q1 372 430.9973 -41.9078978 -17.0893687 413.9079
stl 1991 Q2 436 416.8076 16.3871954 2.8051867 419.6128
stl 1991 Q3 422 413.7419 24.3603303 -16.1021811 397.6397
stl 1991 Q4 423 412.5398 0.7667740 9.6934482 422.2332
stl 1992 Q1 383 411.5209 -39.9805186 11.4596345 422.9805
stl 1992 Q2 404 412.6158 14.9231453 -23.5389131 389.0769
stl 1992 Q3 446 414.0201 23.4210320 8.5588258 422.5790
stl 1992 Q4 420 423.3081 1.5428247 -4.8509590 418.4572
stl 1993 Q1 394 434.0010 -39.0455595 -0.9554068 433.0456
stl 1993 Q2 462 441.4881 13.6233989 6.8884586 448.3766
stl 1993 Q3 475 446.9773 23.8419746 4.1807734 451.1580
stl 1993 Q4 443 451.3194 1.3933488 -9.7127137 441.6067
stl 1994 Q1 421 456.0869 -38.0877688 3.0008934 459.0878
stl 1994 Q2 475 463.4221 12.3585775 -0.7806576 462.6414
stl 1994 Q3 497 468.7874 24.2864881 3.9261368 472.7135
stl 1994 Q4 476 468.2332 1.2247538 6.5420617 474.7752
stl 1995 Q1 430 456.7437 -37.6253815 10.8817298 467.6254
stl 1995 Q2 457 432.7994 11.8717865 12.3288129 445.1282
stl 1995 Q3 417 402.8652 23.8943012 -9.7595381 393.1057
stl 1995 Q4 370 374.7148 2.0825489 -6.7973533 367.9175
stl 1996 Q1 310 357.8769 -37.3666753 -10.5101769 347.3667
stl 1996 Q2 358 353.2201 11.2398397 -6.4598949 346.7602
stl 1996 Q3 379 356.2689 23.4338981 -0.7027909 355.5661
stl 1996 Q4 369 362.9694 2.9521920 3.0784197 366.0478
stl 1997 Q1 330 371.4805 -36.4955462 -4.9849193 366.4955
stl 1997 Q2 390 378.4713 9.7203666 1.8083633 380.2796
stl 1997 Q3 416 381.6685 22.9267368 11.4047824 393.0733
stl 1997 Q4 383 382.2744 4.0243991 -3.2988141 378.9756
stl 1998 Q1 339 381.9366 -35.5728793 -7.3637575 374.5729
stl 1998 Q2 394 386.1365 8.2011066 -0.3376386 385.7989
stl 1998 Q3 412 395.7244 22.3778603 -6.1022633 389.6221
stl 1998 Q4 420 402.3143 5.0338600 12.6518807 414.9661
stl 1999 Q1 376 405.0653 -34.5147710 5.4494954 410.5148
stl 1999 Q2 401 405.6722 6.9673521 -11.6395447 394.0326
stl 1999 Q3 430 409.7637 22.2296766 -1.9933755 407.7703
stl 1999 Q4 417 421.6080 5.0055924 -9.6135440 411.9944
stl 2000 Q1 416 428.4763 -33.3271957 20.8508752 449.3272
stl 2000 Q2 447 422.8365 5.8004007 18.3631399 441.1996
stl 2000 Q3 421 402.2704 22.0212134 -3.2915971 398.9788
stl 2000 Q4 379 373.2748 4.7646153 0.9605958 374.2354
stl 2001 Q1 304 353.6040 -32.7432041 -16.8607850 336.7432
stl 2001 Q2 337 349.5373 6.6612093 -19.1984954 330.3388
stl 2001 Q3 385 357.1866 21.6370352 6.1764055 363.3630
stl 2001 Q4 381 371.0071 3.7110903 6.2817978 377.2889
stl 2002 Q1 345 382.8506 -32.1906782 -5.6599163 377.1907
stl 2002 Q2 405 391.7070 7.6084946 5.6844600 397.3915
stl 2002 Q3 417 402.0895 21.4287595 -6.5182620 395.5712
stl 2002 Q4 420 409.1444 2.8913889 7.9641970 417.1086
stl 2003 Q1 387 413.1090 -32.2459586 6.1369695 419.2460
stl 2003 Q2 415 414.4405 8.0612625 -7.5017618 406.9387
stl 2003 Q3 440 415.8301 21.4021017 2.7678155 418.5979
stl 2003 Q4 413 420.4837 2.6671840 -10.1508696 410.3328
stl 2004 Q1 409 420.7751 -32.3419427 20.5668274 441.3419
stl 2004 Q2 423 416.9737 8.4582547 -2.4319197 414.5417
stl 2004 Q3 428 407.1154 21.3365285 -0.4519072 406.6635
stl 2004 Q4 397 405.1044 2.4301587 -10.5345996 394.5698
stl 2005 Q1 355 405.7322 -32.3033706 -18.4288504 387.3034
stl 2005 Q2 435 407.4196 8.6601652 18.9201897 426.3398 
# plot STL decomposition
components(dcmp) %>% 
     autoplot()

Fit a model (snaive)

fit <- bricks %>% 
     model(SNAIVE(Bricks))

Plot residual diagnostics

fit %>% 
     gg_tsresiduals()

Plot forecast

fit %>% 
     forecast() %>% 
     autoplot(bricks)

Exercise 5.11.7

Create myseries dataset from aus_retail

set.seed(1032)
myseries <- aus_retail %>% 
     filter(`Series ID` == sample(aus_retail$`Series ID`,1))

Subset myseries for observations before year 2011

myseries_train <- myseries %>% 
     filter(year(Month) < 2011)

Plot myseries train and test dataset

myseries %>% 
     autoplot(Turnover) + 
     autolayer(
          myseries_train, 
          Turnover, 
          colour = 'red'
     ) + 
     geom_smooth(method = 'loess', se = FALSE, color = 'steelblue') + 
     labs(x = '')

Fit a seasonal naive model (snaive)

fit <- myseries_train %>% 
     model(SNAIVE(Turnover))

Plot residual diagnostics

fit %>% 
     gg_tsresiduals()

Produce forecasts for the test data

fc <- fit %>%
  forecast(new_data = anti_join(myseries, myseries_train))

fc %>% 
     autoplot(myseries)

Forecast accuracy metrics

fit %>% 
     accuracy()
# A tibble: 1 × 12
  State    Industry .model .type    ME  RMSE   MAE   MPE  MAPE  MASE RMSSE  ACF1
  <chr>    <chr>    <chr>  <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Victoria Pharmac… SNAIV… Trai…  9.87  18.5  12.9  6.96  9.63     1     1 0.791
fc %>% 
     accuracy(myseries)
# A tibble: 1 × 12
  .model     State Indus…¹ .type    ME  RMSE   MAE   MPE  MAPE  MASE RMSSE  ACF1
  <chr>      <chr> <chr>   <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 SNAIVE(Tu… Vict… Pharma… Test   74.8  101.  76.6  17.3  17.9  5.94  5.45 0.927
# … with abbreviated variable name ¹​Industry

How sensitive are the accuracy measures to the amount of training data used? Extremely sensitive. The model fails to capture the model trend.

Exercise 5.11.10

Create takeaway_food_services dataset from aus_retail

takeaway_food_services <- aus_retail %>% 
     filter(State == 'Victoria' & Industry == 'Takeaway food services')

Subset takeaway_food_services for observations before year 2015

takeaway_food_services_train <- takeaway_food_services %>% 
     filter(year(Month) < 2015)

Plot takeaway_food_services train and test dataset

takeaway_food_services %>% 
     autoplot(Turnover) + 
     autolayer(
          takeaway_food_services_train, 
          Turnover, 
          colour = 'red'
     ) + 
     geom_smooth(method = 'loess', se = FALSE, color = 'steelblue') + 
     labs(x = '')

Fit the models (Naive, Seasonal Naive, Drift)

takeaway_food_services_fit <- takeaway_food_services_train %>%
     model(
          `Naïve` = NAIVE(Turnover),
          `Seasonal naïve` = SNAIVE(Turnover), 
          Drift = RW(Turnover ~ drift())
     )

# Generate forecasts for 4 years (48 months)
takeaway_food_services_fc <- takeaway_food_services_fit %>% 
     forecast(h = 48)

takeaway_food_services_fc %>% 
     knitr::kable()
State Industry .model Month Turnover .mean
Victoria Takeaway food services Naïve 2015 Jan N(337, 145) 336.6000
Victoria Takeaway food services Naïve 2015 Feb N(337, 291) 336.6000
Victoria Takeaway food services Naïve 2015 Mar N(337, 436) 336.6000
Victoria Takeaway food services Naïve 2015 Apr N(337, 582) 336.6000
Victoria Takeaway food services Naïve 2015 May N(337, 727) 336.6000
Victoria Takeaway food services Naïve 2015 Jun N(337, 873) 336.6000
Victoria Takeaway food services Naïve 2015 Jul N(337, 1018) 336.6000
Victoria Takeaway food services Naïve 2015 Aug N(337, 1163) 336.6000
Victoria Takeaway food services Naïve 2015 Sep N(337, 1309) 336.6000
Victoria Takeaway food services Naïve 2015 Oct N(337, 1454) 336.6000
Victoria Takeaway food services Naïve 2015 Nov N(337, 1600) 336.6000
Victoria Takeaway food services Naïve 2015 Dec N(337, 1745) 336.6000
Victoria Takeaway food services Naïve 2016 Jan N(337, 1890) 336.6000
Victoria Takeaway food services Naïve 2016 Feb N(337, 2036) 336.6000
Victoria Takeaway food services Naïve 2016 Mar N(337, 2181) 336.6000
Victoria Takeaway food services Naïve 2016 Apr N(337, 2327) 336.6000
Victoria Takeaway food services Naïve 2016 May N(337, 2472) 336.6000
Victoria Takeaway food services Naïve 2016 Jun N(337, 2618) 336.6000
Victoria Takeaway food services Naïve 2016 Jul N(337, 2763) 336.6000
Victoria Takeaway food services Naïve 2016 Aug N(337, 2908) 336.6000
Victoria Takeaway food services Naïve 2016 Sep N(337, 3054) 336.6000
Victoria Takeaway food services Naïve 2016 Oct N(337, 3199) 336.6000
Victoria Takeaway food services Naïve 2016 Nov N(337, 3345) 336.6000
Victoria Takeaway food services Naïve 2016 Dec N(337, 3490) 336.6000
Victoria Takeaway food services Naïve 2017 Jan N(337, 3636) 336.6000
Victoria Takeaway food services Naïve 2017 Feb N(337, 3781) 336.6000
Victoria Takeaway food services Naïve 2017 Mar N(337, 3926) 336.6000
Victoria Takeaway food services Naïve 2017 Apr N(337, 4072) 336.6000
Victoria Takeaway food services Naïve 2017 May N(337, 4217) 336.6000
Victoria Takeaway food services Naïve 2017 Jun N(337, 4363) 336.6000
Victoria Takeaway food services Naïve 2017 Jul N(337, 4508) 336.6000
Victoria Takeaway food services Naïve 2017 Aug N(337, 4654) 336.6000
Victoria Takeaway food services Naïve 2017 Sep N(337, 4799) 336.6000
Victoria Takeaway food services Naïve 2017 Oct N(337, 4944) 336.6000
Victoria Takeaway food services Naïve 2017 Nov N(337, 5090) 336.6000
Victoria Takeaway food services Naïve 2017 Dec N(337, 5235) 336.6000
Victoria Takeaway food services Naïve 2018 Jan N(337, 5381) 336.6000
Victoria Takeaway food services Naïve 2018 Feb N(337, 5526) 336.6000
Victoria Takeaway food services Naïve 2018 Mar N(337, 5671) 336.6000
Victoria Takeaway food services Naïve 2018 Apr N(337, 5817) 336.6000
Victoria Takeaway food services Naïve 2018 May N(337, 5962) 336.6000
Victoria Takeaway food services Naïve 2018 Jun N(337, 6108) 336.6000
Victoria Takeaway food services Naïve 2018 Jul N(337, 6253) 336.6000
Victoria Takeaway food services Naïve 2018 Aug N(337, 6399) 336.6000
Victoria Takeaway food services Naïve 2018 Sep N(337, 6544) 336.6000
Victoria Takeaway food services Naïve 2018 Oct N(337, 6689) 336.6000
Victoria Takeaway food services Naïve 2018 Nov N(337, 6835) 336.6000
Victoria Takeaway food services Naïve 2018 Dec N(337, 6980) 336.6000
Victoria Takeaway food services Seasonal naïve 2015 Jan N(288, 363) 288.3000
Victoria Takeaway food services Seasonal naïve 2015 Feb N(250, 363) 250.1000
Victoria Takeaway food services Seasonal naïve 2015 Mar N(274, 363) 274.3000
Victoria Takeaway food services Seasonal naïve 2015 Apr N(281, 363) 281.4000
Victoria Takeaway food services Seasonal naïve 2015 May N(292, 363) 291.8000
Victoria Takeaway food services Seasonal naïve 2015 Jun N(294, 363) 294.0000
Victoria Takeaway food services Seasonal naïve 2015 Jul N(321, 363) 320.6000
Victoria Takeaway food services Seasonal naïve 2015 Aug N(314, 363) 314.5000
Victoria Takeaway food services Seasonal naïve 2015 Sep N(316, 363) 316.3000
Victoria Takeaway food services Seasonal naïve 2015 Oct N(321, 363) 321.0000
Victoria Takeaway food services Seasonal naïve 2015 Nov N(323, 363) 323.3000
Victoria Takeaway food services Seasonal naïve 2015 Dec N(337, 363) 336.6000
Victoria Takeaway food services Seasonal naïve 2016 Jan N(288, 726) 288.3000
Victoria Takeaway food services Seasonal naïve 2016 Feb N(250, 726) 250.1000
Victoria Takeaway food services Seasonal naïve 2016 Mar N(274, 726) 274.3000
Victoria Takeaway food services Seasonal naïve 2016 Apr N(281, 726) 281.4000
Victoria Takeaway food services Seasonal naïve 2016 May N(292, 726) 291.8000
Victoria Takeaway food services Seasonal naïve 2016 Jun N(294, 726) 294.0000
Victoria Takeaway food services Seasonal naïve 2016 Jul N(321, 726) 320.6000
Victoria Takeaway food services Seasonal naïve 2016 Aug N(314, 726) 314.5000
Victoria Takeaway food services Seasonal naïve 2016 Sep N(316, 726) 316.3000
Victoria Takeaway food services Seasonal naïve 2016 Oct N(321, 726) 321.0000
Victoria Takeaway food services Seasonal naïve 2016 Nov N(323, 726) 323.3000
Victoria Takeaway food services Seasonal naïve 2016 Dec N(337, 726) 336.6000
Victoria Takeaway food services Seasonal naïve 2017 Jan N(288, 1090) 288.3000
Victoria Takeaway food services Seasonal naïve 2017 Feb N(250, 1090) 250.1000
Victoria Takeaway food services Seasonal naïve 2017 Mar N(274, 1090) 274.3000
Victoria Takeaway food services Seasonal naïve 2017 Apr N(281, 1090) 281.4000
Victoria Takeaway food services Seasonal naïve 2017 May N(292, 1090) 291.8000
Victoria Takeaway food services Seasonal naïve 2017 Jun N(294, 1090) 294.0000
Victoria Takeaway food services Seasonal naïve 2017 Jul N(321, 1090) 320.6000
Victoria Takeaway food services Seasonal naïve 2017 Aug N(314, 1090) 314.5000
Victoria Takeaway food services Seasonal naïve 2017 Sep N(316, 1090) 316.3000
Victoria Takeaway food services Seasonal naïve 2017 Oct N(321, 1090) 321.0000
Victoria Takeaway food services Seasonal naïve 2017 Nov N(323, 1090) 323.3000
Victoria Takeaway food services Seasonal naïve 2017 Dec N(337, 1090) 336.6000
Victoria Takeaway food services Seasonal naïve 2018 Jan N(288, 1453) 288.3000
Victoria Takeaway food services Seasonal naïve 2018 Feb N(250, 1453) 250.1000
Victoria Takeaway food services Seasonal naïve 2018 Mar N(274, 1453) 274.3000
Victoria Takeaway food services Seasonal naïve 2018 Apr N(281, 1453) 281.4000
Victoria Takeaway food services Seasonal naïve 2018 May N(292, 1453) 291.8000
Victoria Takeaway food services Seasonal naïve 2018 Jun N(294, 1453) 294.0000
Victoria Takeaway food services Seasonal naïve 2018 Jul N(321, 1453) 320.6000
Victoria Takeaway food services Seasonal naïve 2018 Aug N(314, 1453) 314.5000
Victoria Takeaway food services Seasonal naïve 2018 Sep N(316, 1453) 316.3000
Victoria Takeaway food services Seasonal naïve 2018 Oct N(321, 1453) 321.0000
Victoria Takeaway food services Seasonal naïve 2018 Nov N(323, 1453) 323.3000
Victoria Takeaway food services Seasonal naïve 2018 Dec N(337, 1453) 336.6000
Victoria Takeaway food services Drift 2015 Jan N(337, 145) 337.3344
Victoria Takeaway food services Drift 2015 Feb N(338, 291) 338.0689
Victoria Takeaway food services Drift 2015 Mar N(339, 438) 338.8033
Victoria Takeaway food services Drift 2015 Apr N(340, 585) 339.5378
Victoria Takeaway food services Drift 2015 May N(340, 734) 340.2722
Victoria Takeaway food services Drift 2015 Jun N(341, 883) 341.0066
Victoria Takeaway food services Drift 2015 Jul N(342, 1032) 341.7411
Victoria Takeaway food services Drift 2015 Aug N(342, 1183) 342.4755
Victoria Takeaway food services Drift 2015 Sep N(343, 1334) 343.2099
Victoria Takeaway food services Drift 2015 Oct N(344, 1486) 343.9444
Victoria Takeaway food services Drift 2015 Nov N(345, 1639) 344.6788
Victoria Takeaway food services Drift 2015 Dec N(345, 1792) 345.4133
Victoria Takeaway food services Drift 2016 Jan N(346, 1946) 346.1477
Victoria Takeaway food services Drift 2016 Feb N(347, 2101) 346.8821
Victoria Takeaway food services Drift 2016 Mar N(348, 2257) 347.6166
Victoria Takeaway food services Drift 2016 Apr N(348, 2413) 348.3510
Victoria Takeaway food services Drift 2016 May N(349, 2570) 349.0855
Victoria Takeaway food services Drift 2016 Jun N(350, 2728) 349.8199
Victoria Takeaway food services Drift 2016 Jul N(351, 2887) 350.5543
Victoria Takeaway food services Drift 2016 Aug N(351, 3046) 351.2888
Victoria Takeaway food services Drift 2016 Sep N(352, 3206) 352.0232
Victoria Takeaway food services Drift 2016 Oct N(353, 3367) 352.7577
Victoria Takeaway food services Drift 2016 Nov N(353, 3528) 353.4921
Victoria Takeaway food services Drift 2016 Dec N(354, 3691) 354.2265
Victoria Takeaway food services Drift 2017 Jan N(355, 3854) 354.9610
Victoria Takeaway food services Drift 2017 Feb N(356, 4017) 355.6954
Victoria Takeaway food services Drift 2017 Mar N(356, 4182) 356.4298
Victoria Takeaway food services Drift 2017 Apr N(357, 4347) 357.1643
Victoria Takeaway food services Drift 2017 May N(358, 4513) 357.8987
Victoria Takeaway food services Drift 2017 Jun N(359, 4680) 358.6332
Victoria Takeaway food services Drift 2017 Jul N(359, 4847) 359.3676
Victoria Takeaway food services Drift 2017 Aug N(360, 5016) 360.1020
Victoria Takeaway food services Drift 2017 Sep N(361, 5185) 360.8365
Victoria Takeaway food services Drift 2017 Oct N(362, 5354) 361.5709
Victoria Takeaway food services Drift 2017 Nov N(362, 5525) 362.3054
Victoria Takeaway food services Drift 2017 Dec N(363, 5696) 363.0398
Victoria Takeaway food services Drift 2018 Jan N(364, 5868) 363.7742
Victoria Takeaway food services Drift 2018 Feb N(365, 6041) 364.5087
Victoria Takeaway food services Drift 2018 Mar N(365, 6214) 365.2431
Victoria Takeaway food services Drift 2018 Apr N(366, 6388) 365.9776
Victoria Takeaway food services Drift 2018 May N(367, 6563) 366.7120
Victoria Takeaway food services Drift 2018 Jun N(367, 6739) 367.4464
Victoria Takeaway food services Drift 2018 Jul N(368, 6915) 368.1809
Victoria Takeaway food services Drift 2018 Aug N(369, 7092) 368.9153
Victoria Takeaway food services Drift 2018 Sep N(370, 7270) 369.6497
Victoria Takeaway food services Drift 2018 Oct N(370, 7449) 370.3842
Victoria Takeaway food services Drift 2018 Nov N(371, 7628) 371.1186
Victoria Takeaway food services Drift 2018 Dec N(372, 7808) 371.8531

Plot time series with forecasts

takeaway_food_services_fc %>% 
     autoplot(takeaway_food_services_train, level = NULL) +
     autolayer(
          filter_index(takeaway_food_services, "2015 Jan" ~ "2018 Dec"),
          colour = "black"
     ) +
     labs(
          y = "AUS$",
          title = "Forecasts for Victoria Takeour Food Services Retail"
     ) +
     guides(colour = guide_legend(title = "Forecast"))

Forecast accuracy metrics

takeaway_food_services_fit %>% 
     accuracy()
# A tibble: 3 × 12
  State    Industry  .model .type        ME  RMSE   MAE    MPE  MAPE  MASE RMSSE
  <chr>    <chr>     <chr>  <chr>     <dbl> <dbl> <dbl>  <dbl> <dbl> <dbl> <dbl>
1 Victoria Takeaway… Naïve  Trai…  7.34e- 1  12.1  7.91  0.244  5.30 0.594 0.633
2 Victoria Takeaway… Seaso… Trai…  7.83e+ 0  19.1 13.3   4.82   8.86 1.00  1    
3 Victoria Takeaway… Drift  Trai… -7.98e-16  12.0  7.88 -0.391  5.28 0.591 0.632
# … with 1 more variable: ACF1 <dbl>
takeaway_food_services_fc %>% 
     accuracy(takeaway_food_services)
# A tibble: 3 × 12
  .model    State Indus…¹ .type    ME  RMSE   MAE    MPE  MAPE  MASE RMSSE  ACF1
  <chr>     <chr> <chr>   <chr> <dbl> <dbl> <dbl>  <dbl> <dbl> <dbl> <dbl> <dbl>
1 Drift     Vict… Takeaw… Test  -33.8  41.0  36.0 -11.2  11.8   2.71  2.15 0.449
2 Naïve     Vict… Takeaw… Test  -15.8  32.9  27.6  -5.77  9.00  2.07  1.73 0.616
3 Seasonal… Vict… Takeaw… Test   19.8  28.5  24.8   5.90  7.59  1.86  1.49 0.806
# … with abbreviated variable name ¹​Industry

Seasonal naive has the lower scores for RMSE, MAE, MAPE, MASE and RMSSE.

Plot residual diagnostics

takeaway_food_services_snaive_fit <- takeaway_food_services_train %>%
     model(
          `Seasonal naïve` = SNAIVE(Turnover)
     )

takeaway_food_services_snaive_fit %>% 
     gg_tsresiduals()

Does the residuals from the best method resemble white noise? No (snaive model)

Exercise 5.11.12

Australia tourism dataset

  1. Extract data from the Gold Coast region using filter() and aggregate total overnight trips (sum over Purpose) using summarise(). Call this new dataset gc_tourism.
gc_tourism <- tourism %>% 
     filter(Region == 'Gold Coast') %>% 
     group_by(Purpose) %>% 
     summarise(Trips = sum(Trips)) %>% 
     ungroup()

Plot gc_tourism time series

gc_tourism %>% 
     autoplot() + 
     geom_smooth(method = 'loess', se = FALSE) + 
     labs(x = '', 
          y = 'Trips (thousands)', 
          title = 'Australia Gold Coast Quarterly Visitor Nights (1998 - 2017)'
          )

  1. Using slice() or filter(), create three training sets for this data excluding the last 1, 2 and 3 years. For example, gc_train_1 <- gc_tourism %>% slice(1:(n()-4)).
# exclude last year
gc_train_1 <- gc_tourism %>% 
     filter(as.Date(Quarter) < '2017-01-01')

# exclude last 2 years
gc_train_2 <- gc_tourism %>% 
     filter(as.Date(Quarter) < '2016-01-01')

# exclude last 3 years
gc_train_3 <- gc_tourism %>% 
     filter(as.Date(Quarter) < '2015-01-01')
  1. Compute one year of forecasts for each training set using the seasonal naïve (SNAIVE()) method. Call these gc_fc_1, gc_fc_2 and gc_fc_3, respectively.
# fit model for `gc_train_1`
fit_1 <- gc_train_1 %>% 
     model(SNAIVE(Trips))

# generate forecasts for 1 year (4 quarters)
gc_fc_1 <- fit_1 %>% 
     forecast(h = 4)

# fit model for `gc_train_2`
fit_2 <- gc_train_2 %>% 
     model(SNAIVE(Trips))

# generate forecasts for 1 year (4 quarters)
gc_fc_2 <- fit_2 %>% 
     forecast(h = 4)

# fit model for `gc_train_3`
fit_3 <- gc_train_3 %>% 
     model(SNAIVE(Trips))

# generate forecasts for 1 year (4 quarters)
gc_fc_3 <- fit_3 %>% 
     forecast(h = 4)
  1. Use accuracy() to compare the test set forecast accuracy using MAPE. Comment on these.
# accuracy metrics for `gc_fc_1`
gc_fc_1 %>% 
     accuracy(gc_tourism)
# A tibble: 4 × 11
  .model        Purpose  .type    ME  RMSE   MAE   MPE  MAPE  MASE RMSSE    ACF1
  <chr>         <chr>    <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>   <dbl>
1 SNAIVE(Trips) Business Test  17.4  41.3  38.6   9.63  35.4 1.81  1.59  -0.276 
2 SNAIVE(Trips) Holiday  Test  38.9  73.9  70.7   6.42  13.0 1.42  1.15  -0.213 
3 SNAIVE(Trips) Other    Test  -1.50  6.27  5.61 -9.01  17.3 0.493 0.431 -0.0655
4 SNAIVE(Trips) Visiting Test  20.4  64.2  59.0   5.41  17.8 1.39  1.20  -0.574 
gc_fc_2 %>% 
     accuracy(gc_tourism)
# A tibble: 4 × 11
  .model        Purpose  .type    ME  RMSE   MAE    MPE  MAPE  MASE RMSSE   ACF1
  <chr>         <chr>    <chr> <dbl> <dbl> <dbl>  <dbl> <dbl> <dbl> <dbl>  <dbl>
1 SNAIVE(Trips) Business Test  -1.25 20.6  20.5  -3.70  22.8  0.957 0.784  0.288
2 SNAIVE(Trips) Holiday  Test   5.12 37.4  31.7   0.303  6.34 0.622 0.570 -0.129
3 SNAIVE(Trips) Other    Test   1.11  4.02  3.74  2.41  10.5  0.316 0.269 -0.215
4 SNAIVE(Trips) Visiting Test   7.05 53.9  47.2   0.253 15.7  1.12  1.01  -0.724
gc_fc_3 %>% 
     accuracy(gc_tourism)
# A tibble: 4 × 11
  .model        Purpose  .type    ME  RMSE   MAE   MPE  MAPE  MASE RMSSE   ACF1
  <chr>         <chr>    <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>  <dbl>
1 SNAIVE(Trips) Business Test   1.20  27.3  27.0 -4.18 30.4  1.28  1.04  -0.241
2 SNAIVE(Trips) Holiday  Test  18.5   88.7  84.1  3.03 16.9  1.72  1.39   0.267
3 SNAIVE(Trips) Other    Test   2.82  15.5  12.8  4.45 38.6  1.08  1.04  -0.498
4 SNAIVE(Trips) Visiting Test  13.3   28.4  24.9  5.20  8.84 0.575 0.520 -0.251

Comments:

  • Overall, 2016 (gc_fc_2) forecasts have the lowest measures across metrics.